home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / howtor_1 / icmp.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-08-20  |  7.6 KB  |  219 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "ICMP"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Description = "A ping implementation (Class module)"
  15. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  16. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  17. Option Explicit
  18. '-----CONSTANT DECLARATION-----
  19. Private Const IP_STATUS_BASE = 11000
  20. Private Const IP_SUCCESS = 0
  21. Private Const IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1)
  22. Private Const IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2)
  23. Private Const IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3)
  24. Private Const IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4)
  25. Private Const IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5)
  26. Private Const IP_NO_RESOURCES = (IP_STATUS_BASE + 6)
  27. Private Const IP_BAD_OPTION = (IP_STATUS_BASE + 7)
  28. Private Const IP_HW_ERROR = (IP_STATUS_BASE + 8)
  29. Private Const IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9)
  30. Private Const IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10)
  31. Private Const IP_BAD_REQ = (IP_STATUS_BASE + 11)
  32. Private Const IP_BAD_ROUTE = (IP_STATUS_BASE + 12)
  33. Private Const IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13)
  34. Private Const IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14)
  35. Private Const IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15)
  36. Private Const IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16)
  37. Private Const IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17)
  38. Private Const IP_BAD_DESTINATION = (IP_STATUS_BASE + 18)
  39. Private Const IP_ADDR_DELETED = (IP_STATUS_BASE + 19)
  40. Private Const IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20)
  41. Private Const IP_MTU_CHANGE = (IP_STATUS_BASE + 21)
  42. Private Const IP_UNLOAD = (IP_STATUS_BASE + 22)
  43. Private Const IP_ADDR_ADDED = (IP_STATUS_BASE + 23)
  44. Private Const IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50)
  45. Private Const MAX_IP_STATUS = IP_STATUS_BASE + 50
  46. Private Const IP_PENDING = (IP_STATUS_BASE + 255)
  47. Private Const PING_TIMEOUT = 10000
  48. Private Const WSADESCRIPTION_LEN = 256
  49. Private Const WSASYSSTATUS_LEN = 256
  50. Private Const WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN + 1
  51. Private Const WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN + 1
  52. Private Const SOCKET_ERROR = -1
  53.  
  54. '-----TYPE DECLARATION-----
  55. Private Type IP_OPTION_INFORMATION
  56.     TTL As Byte
  57.     Tos As Byte
  58.     Flags As Byte
  59.     OptionsSize As Byte
  60.     OptionsData As Long
  61. End Type
  62.  
  63. Private Type ICMP_ECHO_REPLY
  64.     Address As Long
  65.     Status As Long
  66.     RoundTripTime As Long
  67.     DataSize As Integer
  68.     Reserved As Integer
  69.     DataPointer As Long
  70.     Options As IP_OPTION_INFORMATION
  71.     Data As String * 128
  72. End Type
  73.  
  74. Private Type Inet_Address
  75.     Byte4 As String * 1
  76.     Byte3 As String * 1
  77.     Byte2 As String * 1
  78.     Byte1 As String * 1
  79. End Type
  80.  
  81. Private Type hostent
  82.     h_name As Long
  83.     h_aliases As Long
  84.     h_addrtype As Integer
  85.     h_length As Integer
  86.     h_addr_list As Long
  87. End Type
  88.  
  89. Private Type tagWSAData
  90.     wVersion As Integer
  91.     wHighVersion As Integer
  92.     szDescription As String * WSADESCRIPTION_LEN_1
  93.     szSystemStatus As String * WSASYSSTATUS_LEN_1
  94.     iMaxSockets As Integer
  95.     iMaxUdpDg As Integer
  96.     lpVendorInfo As String * 200
  97. End Type
  98.  
  99. '-----PRIVATE FUNCTION DECLARATION-----
  100. Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
  101. Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
  102. Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptions As IP_OPTION_INFORMATION, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
  103. Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequested As Integer, lpWSAData As tagWSAData) As Integer
  104. Private Declare Function WSACleanup Lib "wsock32" () As Integer
  105. Private Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) As Long
  106. Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
  107. Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
  108. Private Declare Function GetHostName Lib "wsock32.dll" Alias "gethostname" (ByVal HostName As String, HostLen As Long) As Long
  109. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  110.  
  111. '-----MISC DECLARATIONS-----
  112. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  113. Private IPLong As Inet_Address
  114. Public Event PingError(peErrDescription As String)
  115. Private m_lastIP As String
  116. Public Event PingOK(poSpeed As Long)
  117.  
  118. Public Function DoPing(ByVal HostAddress As String) As Boolean
  119.  
  120.  
  121.     Dim hFile As Long
  122.     Dim lRet As Long
  123.     Dim lIPAddress As Long
  124.     Dim strMessage As String
  125.     Dim pOptions As IP_OPTION_INFORMATION
  126.     Dim pReturn As ICMP_ECHO_REPLY
  127.     Dim iVal As Integer
  128.     Dim lPingRet As Long
  129.     Dim pWsaData As tagWSAData
  130.     Dim buffsize As Long
  131.     Dim TTL As Byte
  132.     buffsize = 128
  133.     TTL = 255
  134.     strMessage = "ICMP ECHO DATA"
  135.     iVal = WSAStartup(&H101, pWsaData)
  136.     lIPAddress = inet_addr(ICMPGetHostByName(HostAddress))
  137.     hFile = IcmpCreateFile()
  138.     pOptions.TTL = TTL
  139.     lRet = IcmpSendEcho(hFile, lIPAddress, strMessage, Len(strMessage), pOptions, pReturn, Len(pReturn), PING_TIMEOUT)
  140.  
  141.  
  142.     If lRet = 0 Then
  143.  
  144.  
  145.         DoPing = False
  146.             RaiseEvent PingError("PING failure! Error = " & pReturn.Status)
  147.         Else
  148.  
  149.  
  150.             If pReturn.Status <> 0 Then
  151.  
  152.  
  153.                 DoPing = False
  154.                     RaiseEvent PingError("PING failure! Error = " & pReturn.Status)
  155.                 Else
  156.  
  157.  
  158.                     DoPing = True
  159.                         RaiseEvent PingOK(pReturn.RoundTripTime)
  160.                     End If
  161.  
  162.                 End If
  163.  
  164.                 lRet = IcmpCloseHandle(hFile)
  165.                 iVal = WSACleanup()
  166.             End Function
  167.  
  168. Public Function ICMPGetHostByName(Host As String) As String
  169.  
  170.     Dim szString As String
  171.     Dim sMsg As String
  172.     Dim PointerToPointer As Long
  173.     Dim hostent As hostent
  174.     Dim ListAddress As Long
  175.     Dim ListAddr As Long
  176.     Dim Address As Long
  177.     szString = String(64, &H0)
  178.     Host = Host + Right$(szString, 64 - Len(Host))
  179.     PointerToPointer = GetHostByName(Host)
  180.  
  181.  
  182.     If PointerToPointer = -1 Then
  183.         ICMPGetHostByName = "0"
  184.     Else
  185.  
  186.  
  187.         If PointerToPointer <> 0 Then
  188.             CopyMemory hostent.h_name, ByVal PointerToPointer, Len(hostent) ' Copy Winsock structure to the VisualBasic structure
  189.             ListAddress = hostent.h_addr_list ' Get the ListAddress of the Address List
  190.             CopyMemory ListAddr, ByVal ListAddress, 4 ' Copy Winsock structure to the VisualBasic structure
  191.             Dim barray(128) As Byte
  192.             CopyMemory barray(1), ByVal ListAddr, 32
  193.             Dim i As Integer
  194.             CopyMemory Address, ByVal ListAddr, 4 ' Get the first list entry from the Address List
  195.             m_lastIP = vbInet_Ntoa(Address)
  196.         Else
  197.             m_lastIP = "Unable to locate host"
  198.         End If
  199.  
  200.     End If
  201.  
  202.     ICMPGetHostByName = m_lastIP
  203. End Function
  204.  
  205.  
  206.  
  207. Private Function vbInet_Ntoa(Address As Long) As String
  208.  
  209.     CopyMemory IPLong, Address, 4
  210.     vbInet_Ntoa = CStr(Asc(IPLong.Byte4)) + "." + CStr(Asc(IPLong.Byte3)) + "." + CStr(Asc(IPLong.Byte2)) + "." + CStr(Asc(IPLong.Byte1))
  211. End Function
  212.  
  213.  
  214.  
  215. Public Property Get LastIP() As String
  216.     LastIP = m_lastIP
  217. End Property
  218.  
  219.